home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / DDOCDEMO.ZIP / COUNT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  2.8 KB  |  139 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. {$X+,V-}
  9.  
  10. unit Count;
  11.  
  12. interface
  13.  
  14. uses Objects, Drivers, Views;
  15.  
  16.  
  17. type
  18.   PCountView = ^TCountView;
  19.   TCountView = object(TView)
  20.     Current: Longint;
  21.     Count: Longint;
  22.     constructor Init(var Bounds: TRect);
  23.     constructor Load(var S: TStream);
  24.     procedure Draw; virtual;
  25.     function GetPalette: PPalette; virtual;
  26.     procedure SetCount(NewCount: Longint);
  27.     procedure IncCount;
  28.     procedure DecCount;
  29.     procedure SetCurrent(NewCurrent: Longint);
  30.     procedure IncCurrent;
  31.     procedure DecCurrent;
  32.     procedure Store(var S: TStream); virtual;
  33.   end;
  34.  
  35. procedure RegisterCount;
  36.  
  37. const
  38.   CCountView = #1#2#3#8#9;
  39.  
  40.   RCountView: TStreamRec = (
  41.     ObjType: 992;
  42.     VmtLink: Ofs(TypeOf(TCountView)^);
  43.     Load: @TCountView.Load;
  44.     Store: @TCountView.Store
  45.   );
  46.  
  47. implementation
  48.  
  49. { TCountView  }
  50. constructor TCountView.Init(var Bounds:TRect);
  51. begin
  52.   inherited Init(Bounds);
  53.   SetCount(0);
  54.   SetCurrent(1);
  55. end;
  56.  
  57. constructor TCountView.Load(var S: TStream);
  58. begin
  59.   inherited Load(S);
  60.   S.Read(Current, SizeOf(Current));
  61.   S.Read(Count, SizeOf(Count));
  62. end;
  63.  
  64. procedure TCountView.Draw;
  65. var
  66.   B: TDrawBuffer;
  67.   C: Word;
  68.   Params: array[0..1] of Longint;
  69.   Start: Word;
  70.   First: String[10];
  71.   Display: String[20];
  72. begin
  73.   C := GetColor(2);  { Uses same color as frame }
  74.   MoveChar(B, '═', C, Size.X);
  75.  
  76.   Params[0] := Current;
  77.   Params[1] := Count;
  78.   FormatStr(Display, ' ~%d~ of %d ', Params);
  79.  
  80.   { If Current is greater than Count, display Current as highlighted }
  81.   if Current > Count then C := GetColor($0504)
  82.   else C := GetColor($0202);
  83.  
  84.   MoveCStr(B, Display, C);
  85.   WriteLine(0, 0, Size.X, Length(Display), B);
  86. end;
  87.  
  88. function TCountView.GetPalette: PPalette;
  89. const
  90.   P: string[Length(CCountView)] = CCountView;
  91. begin
  92.   GetPalette := @P;
  93. end;
  94.  
  95. procedure TCountView.SetCount(NewCount:Longint);
  96. begin
  97.   Count := NewCount;
  98.   DrawView;
  99. end;
  100.  
  101. procedure TCountView.IncCount;
  102. begin
  103.   SetCount(Count + 1);
  104. end;
  105.  
  106. procedure TCountView.DecCount;
  107. begin
  108.   SetCount(Count - 1);
  109. end;
  110.  
  111. procedure TCountView.SetCurrent(NewCurrent:Longint);
  112. begin
  113.   Current := NewCurrent;
  114.   DrawView;
  115. end;
  116.  
  117. procedure TCountView.IncCurrent;
  118. begin
  119.   SetCurrent(Current + 1);
  120. end;
  121.  
  122. procedure TCountView.DecCurrent;
  123. begin
  124.   SetCurrent(Current - 1);
  125. end;
  126.  
  127. procedure TCountView.Store(var S: TStream);
  128. begin
  129.   inherited Store(S);
  130.   S.Write(Current, SizeOf(Current));
  131.   S.Write(Count, SizeOf(Count));
  132. end;
  133.  
  134. procedure RegisterCount;
  135. begin
  136.   RegisterType(RCountView);
  137. end;
  138.  
  139. end.